home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / emacs.lha / emacs-19.16 / lisp / hippie.el < prev    next >
Text File  |  1993-03-17  |  25KB  |  678 lines
  1. ;;; hippie.el --- expand a word trying various ways to find its expansion.
  2.  
  3. ;; Author: Anders Holst <aho@sans.kth.se>
  4. ;; Keywords: extensions
  5.  
  6. ;; Copyright (C) 1992 Free Software Foundation, Inc.
  7. ;;
  8. ;; This file is part of GNU Emacs.
  9.  
  10. ;; GNU Emacs is free software; you can redistribute it and/or modify
  11. ;; it under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; GNU Emacs is distributed in the hope that it will be useful,
  16. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;; GNU General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23. ;; 
  24. ;;  Last change: 4 January 1993
  25.  
  26. ;;; Commentary:
  27. ;;  
  28. ;;  `hippie-expand' is a single function for a lot of different kinds
  29. ;;  of completions and expansions.  Called repeatedly it tries all
  30. ;;  possible completions in succession. 
  31. ;;  Which kinds of completions to try, and in which order, is
  32. ;;  determined by the contents of `hippie-expand-try-functions-list'.
  33. ;;  Much customization of `hippie-expand' can be made by changing the
  34. ;;  order of, removing, or inserting new functions in this list.
  35. ;;  Given a positive numeric argument, `hippie-expand' jumps directly
  36. ;;  ARG functions forward in this list.  Given some other argument
  37. ;;  (a negative argument or just Ctrl-U) it undoes the tried
  38. ;;  completion.
  39. ;;  If the variable `hippie-expand-verbose' is non-nil, `hippie-expand'
  40. ;;  outputs in a message which try-function in the list that is used
  41. ;;  currently (ie. was used currently and will be tried first the next
  42. ;;  time).
  43. ;;  See also the macro `make-hippie-expand-function' below.
  44. ;;  
  45. ;;  A short description of the current try-functions in this file:
  46. ;;    `try-complete-file-name' : very convenient to have in any buffer,
  47. ;;      and not just in the minibuffer or (some) shell-mode.  It goes
  48. ;;      through all possible completions instead of just completing as
  49. ;;      much as is unique.
  50. ;;    `try-complete-file-name-partially' : To insert in the list just
  51. ;;      before `try-complete-file-name' for those who want first to get
  52. ;;      a file name completed only as many characters as is unique.
  53. ;;      (NOTE: Not by default in `hippie-expand-try-functions-list'.)
  54. ;;    `try-expand-all-abbrevs' : can be removed if you don't use abbrevs.
  55. ;;      Otherwise it looks through all abbrev-tables, starting with
  56. ;;      the local followed by the global. 
  57. ;;    `try-expand-line' : Searches the buffer for an entire line that 
  58. ;;      begins exactly as the current line.  Convenient sometimes, for 
  59. ;;      example as a substitute for (or complement to) the history
  60. ;;      list in shell-like buffers.  Remove it if you find it confusing.
  61. ;;    `try-expand-line-all-buffers' : Like `try-expand-line' but searches
  62. ;;      in all buffers (except the current).  (This may be a little
  63. ;;      slow, don't use it unless you are really fond of `hippie-expand'.
  64. ;;      NOTE: Not by default in hippie-expand-try-functions-list.)
  65. ;;    `try-expand-dabbrev' : works exactly as dabbrev-expand (but of
  66. ;;      course in a way compatible with the other try-functions).
  67. ;;    `try-expand-dabbrev-all-buffers' : perhaps the most useful of them,
  68. ;;      like `dabbrev-expand' but searches all Emacs buffers (except the
  69. ;;      current) for matching words.  (No, I don't find this one
  70. ;;      particularly slow.) 
  71. ;;    `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
  72. ;;      through all possibilities instead of completing what is unique.
  73. ;;      Might be tedious (usually a lot of possible completions) and
  74. ;;      since its function is much like `lisp-complete-symbol', which
  75. ;;      already has a key of its own, you might want to remove this.
  76. ;;    `try-complete-lisp-symbol-partially' : To insert in the list just
  77. ;;      before `try-complete-lisp-symbol' for those who first want to get
  78. ;;      completion of what is unique in the name.  (NOTE: Not by
  79. ;;      default in hippie-expand-try-functions-list.)
  80. ;;
  81. ;;  To write new try-functions, consider the following:
  82. ;;  Each try-function takes one argument OLD which is nil the first
  83. ;;  time the function is called and true in succeeding calls for the
  84. ;;  same string to complete.  The first time the function has to
  85. ;;  extract the string before point to complete, and substitute the
  86. ;;  first completion alternative for it.  On following calls it has to
  87. ;;  substitute the next possible completion for the last tried string.
  88. ;;  The try-function is to return t as long as it finds new
  89. ;;  possible completions.  When there are no more alternatives it has
  90. ;;  to restore the text before point to its original contents, and
  91. ;;  return nil (don't beep or message or anything).
  92. ;;  The try-function can (should) use the following functions:
  93. ;;    `he-init-string' : Initializes the text to substitute to the
  94. ;;      contents of the region BEGIN to END.  Also sets the variable
  95. ;;      `he-search-string' to the text to expand.
  96. ;;    `he-substitute-string' : substitutes STR into the region
  97. ;;      initialized with `he-init-string'.  (An optional second argument
  98. ;;      TRANS-CASE non-nil, means transfer of case from the abbreviation
  99. ;;      to the expansion is ok if that is enabled in the buffer.)
  100. ;;    `he-reset-string' : Resets the initialized region to its original
  101. ;;      contents.
  102. ;;  There is also a variable: `he-tried-table' which is meant to contain
  103. ;;  all tried expansions so far.  The try-function can check this 
  104. ;;  variable to see whether an expansion has already been tried
  105. ;;  (hint: `he-string-member'), and add its own tried expansions to it.
  106. ;;
  107. ;;
  108. ;;  KNOWN BUGS
  109. ;;
  110. ;;  It may happen that some completion suggestion occurs twice, in
  111. ;;  spite of the use of `he-tried-table' to prevent that.  This is 
  112. ;;  because different try-functions may try to complete different
  113. ;;  lengths of text, and thus put different amounts of the
  114. ;;  text in `he-try-table'.  Anyway this seems to occur seldom enough not
  115. ;;  to be too disturbing.  Also it should NOT bee possible for the
  116. ;;  opposite situation to occur, that `hippie-expand' misses some
  117. ;;  suggestion because it thinks it has already tried it.
  118. ;;
  119. ;;  
  120. ;;  ACKNOWLEDGEMENT
  121. ;;
  122. ;;  I want to thank Mikael Djurfeldt in discussions with whom the idea
  123. ;;  of this function took form.
  124. ;;  I am also grateful to all those who have given me suggestions on
  125. ;;  how to improve it.
  126. ;;
  127.  
  128. ;;; Code:
  129.  
  130. (defvar he-num -1)
  131.  
  132. (defvar he-string-beg ())
  133.  
  134. (defvar he-string-end ())
  135.  
  136. (defvar he-search-string ())
  137.  
  138. (defvar he-expand-list ())
  139.  
  140. (defvar he-tried-table ())
  141.  
  142. (defvar he-search-loc ())
  143.  
  144. (defvar he-search-bw ())
  145.  
  146. (defvar he-search-bufs ())
  147.  
  148. (defvar hippie-expand-try-functions-list '(try-complete-file-name
  149.                        try-expand-all-abbrevs
  150.                        try-expand-line
  151.                        try-expand-dabbrev
  152.                        try-expand-dabbrev-all-buffers
  153.                        try-complete-lisp-symbol)
  154.   "The list of expansion functions tried in order by `hippie-expand'.
  155. To change the behavior of `hippie-expand', remove, change the order of,
  156. or insert functions in this list.")
  157.  
  158. (defvar hippie-expand-verbose t
  159.   "*Non-nil makes `hippie-expand' output which function it is trying.")
  160.  
  161. (defun hippie-expand (arg)
  162.   "Try to expand text before point, using multiple methods.
  163. The expansion functions in `hippie-expand-try-functions-list' are
  164. tried in order, until a possible expansion is found.  Repeated
  165. application of `hippie-expand' inserts successively possible
  166. expansions.  
  167. With a positive numeric argument, jumps directly to the ARG next
  168. function in this list.  With a negative argument or just \\[universal-argument], 
  169. undoes the expansion." 
  170.   (interactive "P")
  171.   (if (or (not arg) 
  172.       (and (integerp arg) (> arg 0)))
  173.       (let ((first (or (= he-num -1)
  174.                (not (equal this-command last-command)))))
  175.     (if first
  176.         (progn
  177.           (setq he-num -1)
  178.           (setq he-tried-table nil)))
  179.     (if arg
  180.         (if (not first) (he-reset-string))
  181.         (setq arg 0))
  182.     (let ((i (max (+ he-num arg) 0)))
  183.       (while (not (or (>= i (length hippie-expand-try-functions-list))
  184.               (apply (nth i hippie-expand-try-functions-list) 
  185.                  (list (= he-num i)))))
  186.         (setq i (1+ i)))
  187.       (setq he-num i))
  188.     (if (>= he-num (length hippie-expand-try-functions-list))
  189.         (progn
  190.           (setq he-num -1)
  191.           (if first
  192.           (message "No expansion found")
  193.           (message "No further expansions found"))
  194.           (ding))
  195.         (if hippie-expand-verbose
  196.         (message (concat "Using "
  197.                  (prin1-to-string (nth he-num 
  198.                    hippie-expand-try-functions-list)))))))
  199.       (if (>= he-num 0)
  200.       (progn
  201.         (setq he-num -1)
  202.         (he-reset-string)
  203.         (if hippie-expand-verbose
  204.         (message "Undoing expansions"))))))
  205.       
  206. ;; Initializes the region to expand (to between BEG and END).
  207. (defun he-init-string (beg end)
  208.   (setq he-string-beg beg)
  209.   (setq he-string-end end)
  210.   (setq he-search-string (buffer-substring beg end)))
  211.  
  212. ;; Resets the expanded region to its original contents.
  213. (defun he-reset-string ()
  214.   (delete-region he-string-beg he-string-end)
  215.   (insert he-search-string)
  216.   (setq he-string-end (point)))
  217.  
  218. ;; Substitutes an expansion STR into the correct region (the region
  219. ;; initialized with `he-init-string'). 
  220. ;; An optional argument TRANS-CASE means that it is ok to transfer case
  221. ;; from the abbreviation to the expansion if that is possible, and is
  222. ;; enabled in the buffer.
  223. (defun he-substitute-string (str &optional trans-case)
  224.   (let ((trans-case (and trans-case
  225.              case-replace
  226.              case-fold-search
  227.              (he-transfer-case-ok str he-search-string))))
  228.     (he-reset-string)
  229.     (goto-char he-string-beg)
  230.     (search-forward he-search-string)
  231.     (replace-match (if trans-case (downcase str) str)
  232.            (not trans-case)
  233.            'literal)
  234.     (setq he-string-end (point))))
  235.  
  236. (defun he-ordinary-case-p (str)
  237.   (or (string= str (downcase str))
  238.       (string= str (upcase str))
  239.       (string= str (capitalize str))))
  240.  
  241. (defun he-transfer-case-ok (to-str from-str)
  242.   (and (not (string= from-str (substring to-str 0 (length from-str))))
  243.          ;; otherwise transfer is not needed (and this also solves
  244.      ;; some obscure situations)
  245.        (he-ordinary-case-p to-str)
  246.          ;; otherwise case may be significant 
  247.        (he-ordinary-case-p from-str)
  248.          ;; otherwise replace-match wont know what to do
  249.   ))
  250.  
  251. ;; Check if STR is a member of LST.
  252. ;; Ignore case if `case-replace' and `case-fold-search' are both t.
  253. (defun he-string-member (str lst)
  254.   (while (and lst
  255.           (not
  256.            (if (and case-fold-search case-replace)
  257.            (string= (downcase (car lst)) (downcase str))
  258.            (string= (car lst) str))))
  259.     (setq lst (cdr lst)))
  260.   lst)
  261.  
  262. ;;  For the real hippie-expand enthusiast: A macro that makes it
  263. ;;  possible to use many functions like hippie-expand, but with
  264. ;;  different try-functions-lists.
  265. ;;  Usage is for example:
  266. ;;    (fset 'my-complete-file (make-hippie-expand-function
  267. ;;                             '(try-complete-file-name-partially
  268. ;;                               try-complete-file-name)))
  269. ;;    (fset 'my-complete-line (make-hippie-expand-function
  270. ;;                             '(try-expand-line
  271. ;;                               try-expand-line-all-buffers)))
  272. ;;  
  273. (defmacro make-hippie-expand-function (try-list &optional verbose)
  274.   "Construct a function similar to `hippie-expand'.
  275. Make it use the expansion functions in TRY-LIST.  An optional second
  276. argument VERBOSE non-nil makes the function verbose."
  277.   (` '(lambda (arg)
  278.        (, (concat 
  279.            "Try to expand text before point, using the following functions: \n"
  280.        (mapconcat 'prin1-to-string (eval try-list) ", ")))
  281.        (interactive "P")
  282.        (let ((hippie-expand-try-functions-list (, try-list))
  283.          (hippie-expand-verbose (, verbose)))
  284.      (hippie-expand arg)))))
  285.  
  286.  
  287. ;;;  Here follows the try-functions and their requisites:
  288.  
  289. (defun try-complete-file-name (old)
  290.   "Try to complete text as a file name.
  291. The argument OLD has to be nil the first call of this function, and t
  292. for subsequent calls (for further possible completions of the same
  293. string).  It returns t if a new completion is found, nil otherwise."
  294.   (if (not old)
  295.       (progn 
  296.     (he-init-string (he-file-name-beg) (point))
  297.     (let ((name-part (file-name-nondirectory he-search-string))
  298.           (dir-part (expand-file-name (or (file-name-directory
  299.                            he-search-string) ""))))
  300.       (if (not (he-string-member name-part he-tried-table))
  301.           (setq he-tried-table (cons name-part he-tried-table)))
  302.       (if (and (not (equal he-search-string ""))
  303.            (file-directory-p dir-part))
  304.           (setq he-expand-list (sort (file-name-all-completions 
  305.                       name-part
  306.                       dir-part)
  307.                      'string-lessp))
  308.           (setq he-expand-list ())))))
  309.  
  310.   (while (and he-expand-list
  311.           (he-string-member (car he-expand-list) he-tried-table))
  312.     (setq he-expand-list (cdr he-expand-list)))
  313.   (if (null he-expand-list)
  314.       (progn
  315.     (he-reset-string)
  316.     ())
  317.       (let ((filename (concat (file-name-directory he-search-string)
  318.                   (car he-expand-list))))
  319.     (he-substitute-string filename)
  320.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  321.     (setq he-expand-list (cdr he-expand-list))
  322.     t)))
  323.  
  324. (defun try-complete-file-name-partially (old)
  325.   "Try to complete text as a file name, as many characters as unique.
  326. The argument OLD has to be nil the first call of this function.  It
  327. returns t if a unique, possibly partial, completion is found, nil 
  328. otherwise."
  329.   (let ((expansion ()))
  330.     (if (not old)
  331.     (progn 
  332.       (he-init-string (he-file-name-beg) (point))
  333.       (let ((name-part (file-name-nondirectory he-search-string))
  334.         (dir-part (expand-file-name (or (file-name-directory
  335.                          he-search-string) ""))))
  336.         (if (and (not (equal he-search-string ""))
  337.              (file-directory-p dir-part))
  338.         (setq expansion (file-name-completion name-part
  339.                               dir-part)))
  340.         (if (or (eq expansion t)
  341.             (string= expansion name-part))
  342.         (setq expansion ())))))
  343.  
  344.     (if (not expansion)
  345.     (progn
  346.       (he-reset-string)
  347.       ())
  348.     (let ((filename (concat (file-name-directory he-search-string)
  349.                 expansion)))
  350.       (he-substitute-string filename)
  351.       (setq he-tried-table (cons expansion he-tried-table))
  352.       t))))
  353.  
  354. (defun he-file-name-beg ()
  355.   (let ((skips "-a-zA-Z0-9_./~^#$"))
  356.     (save-excursion
  357.       (skip-chars-backward skips)
  358.       (point))))
  359.  
  360. (defun try-complete-lisp-symbol (old)
  361.   "Try to complete word as an Emacs Lisp symbol.
  362. The argument OLD has to be nil the first call of this function, and t
  363. for subsequent calls (for further possible completions of the same
  364. string).  It returns t if a new completion is found, nil otherwise."
  365.   (if (not old)
  366.       (progn 
  367.     (he-init-string (he-lisp-symbol-beg) (point))
  368.     (if (not (he-string-member he-search-string he-tried-table))
  369.         (setq he-tried-table (cons he-search-string he-tried-table)))
  370.     (setq he-expand-list 
  371.           (and (not (equal he-search-string ""))
  372.            (sort (all-completions he-search-string obarray
  373.                       (function (lambda (sym)
  374.                         (or (boundp sym)
  375.                         (fboundp sym)
  376.                         (symbol-plist sym)))))
  377.              'string-lessp)))))
  378.   (while (and he-expand-list
  379.           (he-string-member (car he-expand-list) he-tried-table))
  380.     (setq he-expand-list (cdr he-expand-list)))
  381.   (if (null he-expand-list)
  382.       (progn
  383.     (he-reset-string)
  384.     ())
  385.       (progn
  386.     (he-substitute-string (car he-expand-list))
  387.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  388.     (setq he-expand-list (cdr he-expand-list))
  389.     t)))
  390.  
  391. (defun try-complete-lisp-symbol-partially (old)
  392.   "Try to complete as an Emacs Lisp symbol, as many characters as unique.
  393. The argument OLD has to be nil the first call of this function.  It
  394. returns t if a unique, possibly partial, completion is found, nil 
  395. otherwise."
  396.   (let ((expansion ()))
  397.     (if (not old)
  398.     (progn 
  399.       (he-init-string (he-lisp-symbol-beg) (point))
  400.       (if (not (string= he-search-string ""))
  401.           (setq expansion 
  402.             (try-completion he-search-string obarray
  403.                     (function (lambda (sym)
  404.                       (or (boundp sym)
  405.                       (fboundp sym)
  406.                       (symbol-plist sym)))))))
  407.       (if (or (eq expansion t)
  408.           (string= expansion he-search-string))
  409.           (setq expansion ()))))
  410.  
  411.   (if (not expansion)
  412.       (progn
  413.     (he-reset-string)
  414.     ())
  415.       (progn
  416.     (he-substitute-string expansion)
  417.     (setq he-tried-table (cons expansion he-tried-table))
  418.     t))))
  419.  
  420. (defun he-lisp-symbol-beg ()
  421.   (let ((skips "-a-zA-Z0-9_."))
  422.     (save-excursion
  423.       (skip-chars-backward skips)
  424.       (point))))
  425.  
  426. (defun try-expand-line (old)
  427.   "Try to complete the current line to an entire line in the buffer.
  428. The argument OLD has to be nil the first call of this function, and t
  429. for subsequent calls (for further possible completions of the same
  430. string).  It returns t if a new completion is found, nil otherwise."
  431.   (let ((expansion ())
  432.     (strip-prompt (and (get-buffer-process (current-buffer))
  433.                shell-prompt-pattern)))
  434.     (if (not old)
  435.     (progn
  436.       (he-init-string (he-line-beg strip-prompt) (point))
  437.       (setq he-search-loc he-string-beg)
  438.       (setq he-search-bw t)))
  439.  
  440.     (if (not (equal he-search-string ""))
  441.     (save-excursion
  442.       ;; Try looking backward unless inhibited.
  443.       (if he-search-bw
  444.           (progn 
  445.         (goto-char he-search-loc)
  446.         (setq expansion (he-line-search he-search-string
  447.                         strip-prompt t))
  448.         (setq he-search-loc (point-marker))
  449.         (if (not expansion)
  450.             (progn
  451.               (setq he-search-loc he-string-end)
  452.               (setq he-search-bw ())))))
  453.       
  454.       (if (not expansion) ; Then look forward.
  455.           (progn 
  456.         (goto-char he-search-loc)
  457.         (setq expansion (he-line-search he-search-string 
  458.                         strip-prompt nil))
  459.         (setq he-search-loc (point-marker))))))
  460.  
  461.     (if (not expansion)
  462.     (progn
  463.       (he-reset-string)
  464.       ())
  465.     (progn
  466.       (he-substitute-string expansion t)
  467.       (setq he-tried-table (cons expansion he-tried-table))
  468.       t))))
  469.  
  470. (defun try-expand-line-all-buffers (old)
  471.   "Try to complete the current line, searching all other buffers.
  472. The argument OLD has to be nil the first call of this function, and t
  473. for subsequent calls (for further possible completions of the same
  474. string).  It returns t if a new completion is found, nil otherwise."
  475.   (let ((expansion ())
  476.     (strip-prompt (and (get-buffer-process (current-buffer))
  477.                shell-prompt-pattern))
  478.     (buf (current-buffer)))
  479.     (if (not old)
  480.     (progn
  481.       (he-init-string (he-line-beg strip-prompt) (point))
  482.       (setq he-search-loc 0)
  483.       (setq he-search-bufs (buffer-list))))
  484.  
  485.     (if (not (equal he-search-string ""))
  486.     (while (and he-search-bufs (not expansion))
  487.       (set-buffer (car he-search-bufs))
  488.       (if (and (not (eq (current-buffer) buf))
  489.            (not (eq major-mode 'dired-mode)))
  490.            ;; dont search dired buffers
  491.           (save-excursion
  492.         (goto-char he-search-loc)
  493.         (setq expansion (he-line-search he-search-string
  494.                         strip-prompt nil))
  495.         (setq he-search-loc (point-marker))))
  496.       (if expansion
  497.           (setq he-tried-table (cons expansion he-tried-table))
  498.           (progn
  499.         (setq he-search-loc 0)
  500.         (setq he-search-bufs (cdr he-search-bufs))))))
  501.  
  502.     (set-buffer buf)
  503.     (if (not expansion)
  504.     (progn
  505.       (he-reset-string)
  506.       ())
  507.     (progn
  508.       (he-substitute-string expansion t)
  509.       t))))
  510.  
  511. (defun he-line-search (str strip-prompt reverse) 
  512.   (let ((result ()))
  513.     (while (and (not result)
  514.         (if reverse
  515.             (re-search-backward 
  516.              (he-line-search-regexp str strip-prompt)
  517.              nil t)
  518.             (re-search-forward
  519.              (he-line-search-regexp str strip-prompt)
  520.              nil t)))
  521.       (setq result (buffer-substring (match-beginning 2) (match-end 2)))
  522.       (if (he-string-member result he-tried-table)
  523.       (setq result nil)))                ; if already in table, ignore
  524.     result))
  525.  
  526. (defun he-line-beg (strip-prompt)
  527.   (save-excursion
  528.     (end-of-line)
  529.     (if (re-search-backward (he-line-search-regexp "" strip-prompt) 
  530.                 (save-excursion (beginning-of-line)
  531.                         (point)) t)
  532.     (match-beginning 2)
  533.       (beginning-of-line)
  534.       (point))))
  535.  
  536. (defun he-line-search-regexp (pat strip-prompt)
  537.   (if strip-prompt
  538.       (concat "\\(" shell-prompt-pattern "\\|^\\s-*\\)\\("
  539.           (regexp-quote pat)
  540.           "[^\n]*[^ \t\n]\\)")
  541.       (concat "^\\(\\s-*\\)\\(" 
  542.           (regexp-quote pat)
  543.           "[^\n]*[^ \t\n]\\)")))
  544.  
  545. (defun try-expand-all-abbrevs (old)
  546.   "Try to expand word before point according to all abbrev tables.
  547. The argument OLD has to be nil the first call of this function, and t
  548. for subsequent calls (for further possible expansions of the same
  549. string).  It returns t if a new expansion is found, nil otherwise."
  550.   (if (not old)
  551.       (progn
  552.     (he-init-string (he-dabbrev-beg) (point))
  553.     (setq he-expand-list 
  554.           (and (not (equal he-search-string ""))
  555.            (mapcar (function (lambda (sym)
  556.                  (abbrev-expansion he-search-string 
  557.                            (eval sym))))
  558.                (append '(local-abbrev-table 
  559.                      global-abbrev-table)
  560.                    abbrev-table-name-list))))))
  561.   (while (and he-expand-list
  562.           (or (not (car he-expand-list))
  563.           (he-string-member (car he-expand-list) he-tried-table)))
  564.     (setq he-expand-list (cdr he-expand-list)))
  565.   (if (null he-expand-list)
  566.       (progn
  567.     (he-reset-string)
  568.     ())
  569.       (progn
  570.     (he-substitute-string (car he-expand-list))
  571.     (setq he-tried-table (cons (car he-expand-list) he-tried-table))
  572.     (setq he-expand-list (cdr he-expand-list))
  573.     t)))
  574.  
  575. (defun try-expand-dabbrev (old)
  576.   "Try to expand word \"dynamically\", searching the current buffer.
  577. The argument OLD has to be nil the first call of this function, and t
  578. for subsequent calls (for further possible expansions of the same
  579. string).  It returns t if a new expansion is found, nil otherwise."
  580.   (let ((expansion ()))
  581.     (if (not old)
  582.     (progn
  583.       (he-init-string (he-dabbrev-beg) (point))
  584.       (setq he-search-loc he-string-beg)
  585.       (setq he-search-bw t)))
  586.  
  587.     (if (not (equal he-search-string ""))
  588.     (save-excursion
  589.       ;; Try looking backward unless inhibited.
  590.       (if he-search-bw
  591.           (progn 
  592.         (goto-char he-search-loc)
  593.         (setq expansion (he-dab-search he-search-string t))
  594.         (setq he-search-loc (point-marker))
  595.         (if (not expansion)
  596.             (progn
  597.               (setq he-search-loc he-string-end)
  598.               (setq he-search-bw ())))))
  599.       
  600.       (if (not expansion) ; Then look forward.
  601.           (progn 
  602.         (goto-char he-search-loc)
  603.         (setq expansion (he-dab-search he-search-string nil))
  604.         (setq he-search-loc (point-marker))))))
  605.     
  606.     (if (not expansion)
  607.     (progn
  608.       (he-reset-string)
  609.       ())
  610.     (progn
  611.       (he-substitute-string expansion t)
  612.       (setq he-tried-table (cons expansion he-tried-table))
  613.       t))))
  614.  
  615. (defun try-expand-dabbrev-all-buffers (old)
  616.   "Tries to expand word \"dynamically\", searching all other buffers.
  617. The argument OLD has to be nil the first call of this function, and t
  618. for subsequent calls (for further possible expansions of the same
  619. string).  It returns t if a new expansion is found, nil otherwise."
  620.   (let ((expansion ())
  621.     (buf (current-buffer)))
  622.     (if (not old)
  623.     (progn
  624.       (he-init-string (he-dabbrev-beg) (point))
  625.       (setq he-search-loc 0)
  626.       (setq he-search-bufs (buffer-list))))
  627.  
  628.     (if (not (equal he-search-string ""))
  629.     (while (and he-search-bufs (not expansion))
  630.       (set-buffer (car he-search-bufs))
  631.       (if (and (not (eq (current-buffer) buf))
  632.            (not (eq major-mode 'dired-mode))) 
  633.            ;; dont search dired buffers
  634.           (save-excursion
  635.         (goto-char he-search-loc)
  636.         (setq expansion (he-dab-search he-search-string nil))
  637.         (setq he-search-loc (point-marker))))
  638.       (if expansion
  639.           (setq he-tried-table (cons expansion he-tried-table))
  640.           (progn
  641.         (setq he-search-loc 0)
  642.         (setq he-search-bufs (cdr he-search-bufs))))))
  643.  
  644.     (set-buffer buf)
  645.     (if (not expansion)
  646.     (progn
  647.       (he-reset-string)
  648.       ())
  649.     (progn
  650.       (he-substitute-string expansion t)
  651.       t))))
  652.  
  653. (defun he-dab-search-regexp (pat)
  654.   (concat "\\b" (regexp-quote pat) 
  655.       "\\(\\sw\\|\\s_\\)+"))
  656.  
  657. (defun he-dab-search (pattern reverse)
  658.   (let ((result ()))
  659.     (while (and (not result) 
  660.         (if reverse
  661.              (re-search-backward (he-dab-search-regexp pattern)
  662.                      nil t)
  663.              (re-search-forward (he-dab-search-regexp pattern)
  664.                     nil t)))
  665.       (setq result (buffer-substring (match-beginning 0) (match-end 0)))
  666.       (if (he-string-member result he-tried-table)
  667.       (setq result nil)))                ; if already in table, ignore
  668.     result))
  669.  
  670. (defun he-dabbrev-beg ()
  671.   (let ((skips "-a-zA-Z0-9_."))
  672.     (save-excursion
  673.       (skip-chars-backward skips)
  674.       (skip-chars-forward "-_.")
  675.       (point))))
  676.  
  677. ;;; hippie.el ends here
  678.